/* Definitions for the integer types.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#include <cstring>
#include <climits>
#include <cstdlib>
#include "integer.hpp"
#include "memory.hpp"
#include "stream.hpp"
#include "io.hpp"

KP_DECLS_BEGIN

result<object> idiv_ii (interpreter *interp, object x, object y)
{
  int v1 = as_int (x), v2 = as_int (y);
  if (v2 == 0)
    return (interp->raise ("arith-error", "division by zero"));

  kp_return (fixint (v1 / v2));
}

result<object> mod_ii (interpreter *interp, object x, object y)
{
  int v1 = as_int (x), v2 = as_int (y);
  if (v2 == 0)
    return (interp->raise ("arith-error", "modulo by zero"));

  kp_return (fixint (v1 % v2));
}

object rsh_ii (interpreter *interp, object x, object y)
{
  int v2 = as_int (y);
  kp_return (v2 >= 0 ? fixint (as_int (x) >> v2) :
                       lsh_ii (interp, x, neg_i (interp, y)));
}

static object bigint_lsh (interpreter *, const bigint *, int, int);

object lsh_ii (interpreter *interp, object x, object y)
{
  int v1 = as_int (x), v2 = as_int (y);

  if (v2 < 0)
    return (fixint (v1 >> -v2));
  else if (v2 >= FIXINT_BITS ||
      (uintptr_t)abs (v1) > (1u << (FIXINT_BITS - v2)))
    {
      local_varobj<bigint> tmp;
      limb_t data = (limb_t)abs (v1);

      tmp.local_init (&data, 1);
      kp_return (bigint_lsh (interp, &tmp, v2, v1 < 0));
    }

  kp_return (fixint (v1 << v2));
}

// Bigint implementation.

static_assert (alignof (bigint) % alignof (limb_t) == 0,
               "invalid alignment for big integers");

bigint* bigint::alloc_raw (int len)
{
  bigint *retp = (bigint *)alloch (sizeof (*retp) + sizeof (limb_t) * len,
                                   typecode::BIGINT, TYPE_SHIFT + 1);

  retp->len = len;
  retp->data = (limb_t *)&retp[1];
  retp->vo_full |= FLAGS_CONST;

  return (retp);
}

object alloc_bigint (interpreter *interp, int len)
{
  auto retp = bigint::alloc_raw (len);
  interp->alval = retp->as_obj ();
  gc_register (interp, retp, sizeof (*retp) + len * sizeof (limb_t));
  return (interp->alval);
}

static inline bigint* get_bigint (object obj, int& sign)
{
#ifdef KP_ARCH_WIDE
  sign = varobj_sign (obj);
#else
  sign = as_bigint(obj)->len < 0;
#endif
  return (as_bigint (obj));
}

#ifdef KP_ARCH_WIDE
#  define make_bigint(ptr, sign)   \
     ptrtype ((ptr), typecode::BIGINT) | ((sign) ? SIGN_BIT : 0)

#  define I_ABS(val)   val
#else

static object make_bigint (bigint *ptr, int sign)
{
  if (sign)
    ptr->len = -ptr->len;
  return (ptr->as_obj ());
}

#  define I_ABS   abs

#endif

// SRC must be allocated, but *not* registered.
static object 
ret_I (interpreter *interp, bigint *src, int sign)
{
  if (src->len == 1 && *src->data <= (limb_t)FIXINT_MAX + sign)
    {
      int tmp = sign ? -(int)*src->data : *src->data;
      xfree (src);
      return (fixint (tmp));
    }

  interp->alval = make_bigint (src, sign);
  gc_register (interp, src, sizeof (*src) + src->len * sizeof (limb_t));
  return (interp->alval);
}

object bigint::make (interpreter *interp, int64_t val)
{
  uival uval;
  bigint *ret = as_bigint (alloc_bigint (interp, 2));
  int sign = val < 0 ? (uval.qv = -val, 1) : (uval.qv = val, 0);

  ret->data[0] = uval.limbs.lo, ret->data[1] = uval.limbs.hi;
  ret->len = 1 + (ret->data[1] != 0);
  kp_return (make_bigint (ret, sign));
}

object bigint::make (interpreter *interp, uint64_t val)
{
  bigint *ret = as_bigint (alloc_bigint (interp, 2));
  ret->data[0] = (uint32_t)val, ret->data[1] = (uint32_t)(val >> 32);
  ret->len = 1 + (ret->data[1] != 0);
  kp_return (make_bigint (ret, 0));
}

bool bigint::cast (object self, int64_t& out)
{
  if (!bigint_p (self))
    return (false);

  const bigint *lp = as_bigint (self);
#ifdef KP_ARCH_WIDE
  int sign = (self & SIGN_BIT) / SIGN_BIT;
#else
  int sign = lp->len < 0;
#endif

  if (lp->len > 2)
    return (false);

  uint64_t uv = lp->data[0] +
                (I_ABS (lp->len) < 2 ? 0 : ((uint64_t)lp->data[1] << 32));
  if (uv > (uint64_t)INT64_MAX + sign)
    return (false);

  out = sign ? -(int64_t)uv : uv;
  return (true);
}

bool bigint::cast (object self, uint64_t& out)
{
  if (!bigint_p (self))
    return (false);

  const bigint *lp = as_bigint (self);
#ifdef KP_ARCH_WIDE
  int sign = (self & SIGN_BIT) / SIGN_BIT;
#else
  int sign = lp->len < 0;
#endif

  if (lp->len > 2 || sign)
    return (false);

  out = lp->data[0] + (lp->len < 2 ? 0 : (uint64_t)lp->data[1] << 32);
  return (true);
}

uint32_t hash_I (interpreter *interp, object obj)
{
  int sign;
  const auto lp = get_bigint (obj, sign);
  uint32_t ret = 2 * lp->len;

  for (int i = 0; i < I_ABS (lp->len); ++i)
    ret = mix_hash (ret, lp->data[i]);

  return (sign ? ~ret : ret);
}

object add_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);

  if (s1 == s2)
    {
      int xl = I_ABS (v1->len), yl = I_ABS (v2->len), len = max (xl, yl);
      auto ret = bigint::alloc_raw (len + 1);
      ret->len = len + uiadd (ret->data, v1->data, xl, v2->data, yl);

      kp_return (ret_I (interp, ret, s1));
    }
  else if (s1 != 0)
    // -x + y => y - x
    return (sub_II (interp, y, x));
  else
    // x + (-y) => x - y
    return (sub_II (interp, x, y));
}

object add_iI (interpreter *interp, object x, object y)
{
  int sign;
  const auto v2 = get_bigint (y, sign);
  int v1 = as_int (x), yl = I_ABS (v2->len);
  bigint *ret;

  if (v1 == 0)
    return (y);
  else if (!(sign ^ (v1 < 0)))
    {
      ret = bigint::alloc_raw (yl + 1);
      ret->len = yl + uiadd1 (ret->data, v2->data, yl, abs (v1));
      ret->data[yl] = ret->len - yl;
    }
  else
    {
      ret = bigint::alloc_raw (yl);
      ret->len = yl - uisub1 (ret->data, v2->data, yl, abs (v1));
    }

  kp_return (ret_I (interp, ret, sign));
}

object sub_II (interpreter *interp, object x, object y)
{
  int s1, s2, rs;
  auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);

  if (xl < yl)
    {
      swap (v1, v2);
      swap (xl, yl);
      swap (s1, s2);
    }

  auto ret = bigint::alloc_raw (xl + 1);

  if (s1 == s2)
    { // Equal signs - subtract.
      if (xl != yl)
        {
          uisub (ret->data, v1->data, xl, v2->data, yl);
          rs = s1;
        }
      else if (uicmp (v1->data, v1->len, v2->data, v2->len) < 0)
        {
          uisubn (ret->data, v2->data, v1->data, xl);
          rs = !s1;
        }
      else
        {
          uisubn (ret->data, v1->data, v2->data, xl);
          rs = s1;
        }

      ret->len = xl;
      uitrim (ret->data, ret->len);
    }
  else
    { // Different signs - add.
      ret->len = xl + uiadd (ret->data, v1->data, xl, v2->data, yl);
      rs = s1;
    }

  kp_return (ret_I (interp, ret, rs));
}

object neg_I (interpreter *interp, object obj)
{
#ifdef KP_ARCH_WIDE
  kp_return (obj ^ SIGN_BIT);
#else
  const bigint *src = as_bigint (obj);
  bigint *ret = as_bigint (alloc_bigint (interp, src->len));
  memcpy (ret->data, src->data, I_ABS (src->len) * sizeof (limb_t));
  ret->len = -src->len;
  kp_return (interp->alval);
#endif
}

object sub_iI (interpreter *interp, object x, object y)
{
  int sign;
  const auto v2 = get_bigint (y, sign);
  int v1 = as_int (x), yl = I_ABS (v2->len);
  bigint *ret;

  if (v1 == 0)
    return (neg_I (interp, y));
  else if (!(sign ^ (v1 < 0)))
    {
      ret = bigint::alloc_raw (yl);
      ret->len = yl - uisub1 (ret->data, v2->data, yl, abs (v1));
    }
  else
    {
      ret = bigint::alloc_raw (yl + 1);
      ret->len = yl + uiadd1 (ret->data, v2->data, yl, abs (v1));
      ret->data[ret->len] = ret->len - yl;
    }

  kp_return (ret_I (interp, ret, sign ^ 1));
}

object mul_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);

  auto ret = bigint::alloc_raw (xl + yl);
  limb_t cy = v1->data == v2->data ?
    uisqr (interp, ret->data, v1->data, xl) :
    uimul (interp, ret->data, v1->data, xl, v2->data, yl);

  ret->len = xl + yl - (cy == 0);
  kp_return (ret_I (interp, ret, s1 ^ s2));
}

object mul_iI (interpreter *interp, object x, object y)
{
  int sign;
  const auto v2 = get_bigint (y, sign);
  int v1 = as_int (x), yl = I_ABS (v2->len);

  if (v1 == 0)
    kp_return (fixint (0));
  else if (v1 == 1)
    kp_return (y);

  auto ret = bigint::alloc_raw (yl + 1);
  ret->len = yl + uimul1 (ret->data, v2->data, yl, abs (v1));
  kp_return (ret_I (interp, ret, sign ^ (v1 < 0)));
}

object idiv_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);

  if (xl < yl)
    kp_return (fixint (0));

  auto ret = bigint::alloc_raw (xl - yl + 1);
  if (yl == 1)
    {
      ret->len = xl;
      uidivrem1 (ret->data, v1->data, xl, *v2->data);
      uitrim (ret->data, ret->len);
    }
  else
    {
      tmp_allocator ta { interp };
      limb_t *tmp = (limb_t *)ta.alloc ((xl + 1) * sizeof (*tmp));
      ret->len = uidiv (interp, v1->data, xl, v2->data, yl, tmp, false);
      // The quotient is at &TMP[length (Y)].
      memcpy (ret->data, tmp + yl, ret->len * sizeof (limb_t));
    }

  kp_return (ret_I (interp, ret, s1 ^ s2));
}

object idiv_iI (interpreter *interp, object, object)
{
  kp_return (fixint (0));
}

result<object> idiv_Ii (interpreter *interp, object x, object y)
{
  int sign;
  const auto v1 = get_bigint (x, sign);
  int v2 = as_int (y), xl = I_ABS (v1->len);

  if (v2 == 0)
    return (interp->raise ("arith-error", "division by zero"));

  auto ret = bigint::alloc_raw (xl);
  ret->len = xl;
  uidivrem1 (ret->data, v1->data, xl, abs (v2));
  uitrim (ret->data, ret->len);

  kp_return (ret_I (interp, ret, sign ^ (v2 < 0)));
}

object mod_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);

  if (xl < yl)
    kp_return (x);
  else if (v1->data == v2->data)
    kp_return (fixint (s1 ? -1 : 1));

  tmp_allocator ta { interp };
  limb_t *tmp = (limb_t *)ta.alloc ((xl + 1) * sizeof (*tmp));
  auto ret = bigint::alloc_raw (yl);
  ret->len = yl;
  
  uidiv (interp, v1->data, xl, v2->data, yl, tmp, true);
  // Remainder is not normalised.
  uitrim (tmp, ret->len);
  memcpy (ret->data, tmp, ret->len * sizeof (limb_t));
  kp_return (ret_I (interp, ret, s1));
}

object mod_iI (interpreter *interp, object x, object)
{
  kp_return (x);
}

result<object> mod_Ii (interpreter *interp, object x, object y)
{
  int sign, v2 = as_int (y);
  const auto v1 = get_bigint (x, sign);
  int xl = I_ABS (v1->len);
  tmp_allocator ta { interp };

  if (v2 == 0)
    return (interp->raise ("arith-error", "modulo by zero"));

  limb_t *tmp = (limb_t *)ta.alloc (xl * sizeof (*tmp));
  limb_t rem = uidivrem1 (tmp, v1->data, xl, abs (v2));

  kp_return (fixint (sign ? -(int)rem : rem));
}

object not_I (interpreter *interp, object obj)
{
  int sign;
  const auto v1 = get_bigint (obj, sign);
  int xl = I_ABS (v1->len);
  auto ret = bigint::alloc_raw (xl + 1);

  // -x == ~x + 1; therefore: ~x = -x - 1, or -(x + 1).
  ret->len = xl + uiadd1 (ret->data, v1->data, xl, 1);
  kp_return (ret_I (interp, ret, sign ^ 1));
}

object land_II (interpreter *interp, object x, object y)
{
  int i, len, s1, s2;
  auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
  bigint *ret;
  tmp_allocator ta { interp };

  if (s1 == 0)
    {
      if (s2 == 0)
        {
          len = min (xl, yl);
          for (i = len - 1; i >= 0; --i)
            if ((v1->data[i] & v2->data[i]) != 0)
              break;

          ret = bigint::alloc_raw (len = i + 1);
          for (i = 0; i < len; ++i)
            ret->data[i] = v1->data[i] & v2->data[i];
          
          kp_return (ret_I (interp, ret, 0));
        }
    }
  else if (s2 != 0)
    { // -X & -Y == ((X - 1) | (Y - 1)).
      limb_t *xp = (limb_t *)ta.alloc ((xl + yl) * sizeof (*xp));
      limb_t *yp = xp + xl;
      if (xl > yl)
        {
          swap (xp, yp);
          swap (xl, yl);
        }

      uisub1 (xp, v1->data, xl, 1);
      uisub1 (yp, v2->data, yl, 1);

      ret = bigint::alloc_raw (yl + 1);
      ret->len = yl;
      memcpy (ret->data + xl, yp + xl, (yl - xl) * sizeof (limb_t));
          
      for (i = 0; i < xl; ++i)
        ret->data[i] = xp[i] | yp[i];
          
      limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
      ret->data[ret->len] = cy;
      ret->len += cy != 0;

      kp_return (ret_I (interp, ret, 1));
    }
  else
    { // Compute -X & Y.
      swap (v1, v2);
      swap (xl, yl);
    }

  // At this point Y is negative and 1-extended. X is positive.
  limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
  uisub1 (xp, v2->data, yl, 1);

  if (xl > yl)
    {
      ret = bigint::alloc_raw (len = xl);
      memcpy (ret->data + yl, v1->data + yl, (len - yl) * sizeof (limb_t));
      for (i = 0; i < yl; ++i)
        ret->data[i] = v1->data[i] & v2->data[i];

      ret->len = len;
      kp_return (ret_I (interp, ret, 0));
    }

  for (i = xl - 1; i >= 0; --i)
    if ((v1->data[i] & ~v2->data[i]) != 0)
      break;

  if (i < 0)
    kp_return (fixint (0));

  ret = bigint::alloc_raw (len = i + 1);
  for (i = 0; i < len; ++i)
    ret->data[i] = v1->data[i] & ~v2->data[i];
    
  ret->len = len;
  kp_return (ret_I (interp, ret, 0));
}

object lor_II (interpreter *interp, object x, object y)
{
  int s1, s2, len, i;
  auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
  bigint *ret;
  tmp_allocator ta { interp };

  if (s1 == 0)
    {
      if (s2 == 0)
        {
          if (yl > xl)
            {
              swap (v1, v2);
              swap (xl, yl);
            }

          // Y < X at this point.
          ret = bigint::alloc_raw (xl);
          memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
          for (i = 0; i < yl; ++i)
            ret->data[i] = v1->data[i] | v2->data[i];

          ret->len = xl;
          kp_return (ret_I (interp, ret, 0));
        }
    }
  else if (s2 != 0)
    { // -X | -Y == ((X - 1) & (Y - 1)).
      len = min (xl, yl);
      limb_t *xp = (limb_t *)ta.alloc (len * 2 * sizeof (*xp));
      limb_t *yp = xp + len;

      uisub1 (xp, v1->data, len, 1);
      uisub1 (yp, v2->data, len, 1);
      for (i = len - 1; i >= 0; --i)
        if ((xp[i] & yp[i]) != 0)
          break;

      if (i < 0)
        return (fixint (1));

      ret = bigint::alloc_raw (len = i + 1);
      uiaddn (ret->data, xp, yp, len);
      ret->data[ret->len = len] = 0;
      uiadd1 (ret->data, ret->data, ret->len + 1, 1);
      ret->len += ret->data[ret->len];
      kp_return (ret_I (interp, ret, 1));
    }
  else
    {
      swap (v1, v2);
      swap (xl, yl);
    }

  limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
  limb_t *yp = xp;

  ret = bigint::alloc_raw (yl);
  uisub1 (xp, v2->data, xl, 1);
  int cnt, zl = yl - (yp[yl - 1] == 0);

  if (xl > zl)
    {
      for (i = zl - 1; i >= 0; --i)
        if ((~v1->data[i] & yp[i]) != 0)
          break;
        
      cnt = ret->len = i + 1;
    }
  else
    {
      ret->len = zl;
      memcpy (ret->data + xl, yp + xl, (zl - xl) * sizeof (limb_t));
      cnt = xl;
    }

  if (ret->len != 0)
    {
      for (i = 0; i < cnt; ++i)
        ret->data[i] = yp[i] & ~v1->data[i];
        
      limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
      if (cy != 0)
        ret->data[ret->len++] = cy;
        
      kp_return (ret_I (interp, ret, 1));
    }

  kp_return (fixint (1));
}

object xor_II (interpreter *interp, object x, object y)
{
  int s1, s2, i, len;
  auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
  bigint *ret;
  tmp_allocator ta { interp };

  if (s1 == 0)
    {
      if (s2 == 0)
        {
          if (yl > xl)
            {
              swap (v1, v2);
              swap (xl, yl);
            }
          
          ret = bigint::alloc_raw (xl);
          memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
          for (i = 0; i < yl; ++i)
            ret->data[i] = v1->data[i] ^ v2->data[i];
          
          ret->len = xl;
        }
    }
  else if (s2 != 0)
    {
      limb_t *xp = (limb_t *)ta.alloc ((xl + yl) * sizeof (*xp));
      limb_t *yp = xp + xl;

      uisub1 (xp, v1->data, xl, 1);
      uisub1 (yp, v2->data, yl, 1);
          
      if (xl > yl)
        {
          swap (xl, yl);
          swap (xp, yp);
        }
          
      ret = bigint::alloc_raw (yl);
      memcpy (ret->data + xl, yp + xl, (yl - xl) * sizeof (limb_t));
      for (i = 0; i < xl; ++i)
        ret->data[i] = xp[i] ^ yp[i];

      ret->len = yl;
      uitrim (ret->data, ret->len);
      kp_return (ret_I (interp, ret, 0));
    }
  else
    {
      swap (v1, v2);
      swap (xl, yl);
    }

  limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
  uisub1 (xp, v2->data, yl, 1);

  len = max (xl, yl) + 1;
  ret = bigint::alloc_raw (len);

  if (xl > yl)
    {
      memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
      for (i = 0; i < yl; ++i)
        ret->data[i] = v1->data[i] ^ v2->data[i];
        
      ret->len = xl;
    }
  else
    {
      memcpy (ret->data + xl, v2->data + xl, (yl - xl) * sizeof (limb_t));
      for (i = 0; i < xl; ++i)
        ret->data[i] = v1->data[i] ^ v2->data[i];
        
      ret->len = yl;
    }
    
  limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
  ret->data[ret->len] = cy;
  ret->len += (cy != 0);
  uitrim (ret->data, ret->len);
  kp_return (ret_I (interp, ret, 1));
}

template <object (*fn) (interpreter *, object, object)>
object log_function (interpreter *interp, object x, object y)
{
  int v = as_int (x), sign = 0;
  limb_t limb = v < 0 ? (sign = 1, (limb_t)-v) : v;
  local_varobj<bigint> tmp;

  tmp.local_init (&limb, 1);
  return (fn (interp, y, make_bigint (&tmp, sign)));
}

object land_iI (interpreter *interp, object x, object y)
{
  return (log_function<land_II> (interp, x, y));
}

object lor_iI (interpreter *interp, object x, object y)
{
  return (log_function<lor_II> (interp, x, y));
}

object xor_iI (interpreter *interp, object x, object y)
{
  return (log_function<xor_II> (interp, x, y));
}

int cmp_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  int ret = s1 != s2 ? 1 :
                       uicmp (v1->data, I_ABS (v1->len),
                              v2->data, I_ABS (v2->len));

  return (s1 ? -ret : ret);
}

int cmp_iI (interpreter *, object, object y)
{
#ifdef KP_ARCH_WIDE
  return ((y & SIGN_BIT) ? 1 : -1);
#else
  return (as_bigint(y)->len < 0 ? 1 : -1);
#endif
}

bool eq_II (interpreter *interp, object x, object y)
{
  int s1, s2;
  const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
  return (s1 == s2 && v1->len == v2->len &&
          memcmp (v1->data, v2->data,
                  I_ABS (v1->len) * sizeof (*v1->data)) == 0);
}

static object
bigint_lsh (interpreter *interp,
            const bigint *v1, int v2, int sign)
{
  int delta = v2 / LIMB_BITS, cnt = v2 % LIMB_BITS;
  int xl = I_ABS (v1->len), len = xl + delta;
  auto ret = bigint::alloc_raw (len + 1);

  ret->len = len;
  if (cnt != 0)
    ret->len += uilsh (ret->data + delta, v1->data, xl, cnt);
  else
    memcpy (ret->data + delta, v1->data, xl * sizeof (limb_t));

  memset (ret->data, 0, delta * sizeof (limb_t));
  return (ret_I (interp, ret, sign));
}

static object
bigint_rsh (interpreter *interp,
            const bigint *v1, int v2, int sign)
{
  int delta = v2 / LIMB_BITS, len = I_ABS (v1->len) - delta;

  if (len <= 0)
    return (fixint (0));
  
  auto ret = bigint::alloc_raw (len);
  int cnt = v2 % KP_LIMB_BITS;
      
  if (cnt != 0)
    ret->len -= 1 - uirsh (ret->data, v1->data + delta, len, cnt);
  else
    memcpy (ret->data, v1->data + delta, ret->len * sizeof (limb_t));
  
  return (ret_I (interp, ret, sign));
}

object lsh_Ii (interpreter *interp, object x, object y)
{
  int sign, v2 = as_int (y);
  const auto v1 = get_bigint (x, sign);

  if (v2 == 0)
    kp_return (x);
  else if (v2 < 0)
    kp_return (bigint_rsh (interp, v1, -v2, sign));
  else
    kp_return (bigint_lsh (interp, v1, v2, sign));
}

object rsh_Ii (interpreter *interp, object x, object y)
{
  int sign, v2 = as_int (y);
  const auto v1 = get_bigint (x, sign);

  if (v2 == 0)
    kp_return (x);
  else if (v2 < 0)
    kp_return (bigint_lsh (interp, v1, -v2, sign));
  else
    kp_return (bigint_rsh (interp, v1, v2, sign));
}

// I/O with integers.

result<int64_t> write_i (interpreter *interp, stream *strm,
                         object obj, io_info& info)
{
  int x = as_int (obj), sign = 0, ret = 0;
  char buf[KP_LIMB_BITS];
  limb_t ux = x < 0 ? (sign = 1, (limb_t)-x) : (limb_t)x;
  char *p = uitostr1 (&buf[sizeof (buf)], ux, info.radix);

  if (sign != 0)
    { ret += KP_TRY (strm->putb (interp, '-')); }

  ret += KP_TRY (strm->wbase (interp, abs (info.radix)));
  ret += KP_TRY (strm->write (interp, p, &buf[sizeof (buf)] - p));
  return (ret);
}

result<int64_t> write_I (interpreter *interp, stream *strm,
                         object obj, io_info& info)
{
  const bigint *x = as_bigint (obj);
  int xl = I_ABS (x->len);
  int size = uibsize (info.radix, x->data[xl - 1], xl) + KP_LIMB_BITS;
  tmp_allocator ta { interp };
  char *ptr = (char *)ta.alloc (size);
  int64_t ret = 0;

  size = uitostr (interp, &ptr, size, x->data, xl, info.radix);

#ifdef KP_ARCH_WIDE
  if (obj & SIGN_BIT)
#else
  if (x->len < 0)
#endif
    { ret += KP_TRY (strm->putb (interp, '-')); }

  ret += KP_TRY (strm->wbase (interp, abs (info.radix)));
  ret += KP_TRY (strm->write (interp, ptr, size));
  return (ret);
}

result<int64_t> pack_i (interpreter *interp, stream *strm,
                        object obj, pack_info&)
{
  int val = as_int (obj);
  val = (int)KP_TRY (strm->write (interp, &val));
  return (val);
}

result<int64_t> pack_I (interpreter *interp, stream *strm,
                        object obj, pack_info&)
{
  int sv;
  const auto bi = get_bigint (obj, sv);
  int len = I_ABS (bi->len);
  int64_t ret = 0;

  sv = sv < 0 ? -len : len;
  ret += KP_TRY (strm->write (interp, &sv));
  ret += KP_TRY (strm->write (interp, bi->data, bi->len * sizeof (*bi->data)));
  return (ret);
}

result<object> unpack_i (interpreter *interp, stream *strm,
                         pack_info& info, bool)
{
  int val;
  bool rv = KP_TRY (strm->sread (interp, &val));
  if (rv)
    kp_return (fixint (val));
  return (info.error ("invalid integer read"));
}

result<object> unpack_I (interpreter *interp, stream *strm,
                         pack_info& info, bool save)
{
  int len;
  bool rv = KP_TRY (strm->sread (interp, &len));
  if (!rv || !len)
    return (info.error ("invalid bigint length"));

  int sign = len < 0 ? (len = -len, 1) : 0;
  bigint *ret = as_bigint (alloc_bigint (interp, len));
  int nb = KP_TRY (strm->read (interp, ret->data,
                               ret->len * sizeof (*ret->data)));

  if (nb < len * (int)sizeof (*ret->data))
    return (info.error ("invalid bigint limbs read"));

  interp->retval = make_bigint (ret, sign);
  if (save)
   KP_VTRY (info.add_mapping (interp, *info.offset, interp->retval));

  return (interp->retval);
}

KP_DECLS_END
